perm filename MAKE.SAI[11,ALS] blob
sn#060633 filedate 1973-09-05 generic text, type T, neo UTF8
00010 BEGIN "MAKE"
00020
00030 DEFINE ⊂="COMMENT";
00060 REQUIRE "BLOCKS.HDR[4,ALS]" SOURCE_FILE;
00070 INTEGER I,J,K,L,Q,P,CHAN1,CHAN2,CHAN3,CHAN4,EOF,HPOINT;
00080 INTEGER HPNT1,HPNT2,HPNT3,HPNT4;
00090 STRING READ1,READ2,READ3,READ4,READ5;
00100 INTEGER ARRAY INSAVE[0:4];
00110
00111 PROCEDURE OUTALL(STRING S);
00112 BEGIN
00113 STRING SS; INTEGER J;
00114 SETBREAK(18,0,NULL,"OSN");
00115 SS←SCAN(S,18,J);
00116 OUTSTR(SS);
00117 END;
00120
00125 SETBREAK(18,0,NULL,"OSN");
00130 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4;
00140 HEADIN; ⊂ Bring in header information;
00150 OUTSTR(CRLF&"This routine is used to generate SIGNATURE TABLES."&CRLF);
00160 OUTSTR("It will ask a number of questions which must be answered by"&CRLF
00170 &" typing the required information followed by a CR."&CRLF);
00180
00190 OUTSTR("PH list and H list table contains"&CRLF);
00200 OUTSTR(CRLF&"PH"&TB&"Significant features"&CRLF);
00210 FOR I←0 STEP 1 UNTIL 63 DO BEGIN
00220 IF PHLIST[I]=0 THEN DONE;
00230 OUTSTR(CVSTR(PHLIST[I]));
00235 OUTSTR(TB);
00240 HPOINT←POINT(1,HLIST[I],-1);
00250 FOR J←0 STEP 1 UNTIL 35 DO
00260 IF (K←ILDB(HPOINT))=1 THEN BEGIN
00265 OUTSTR(CVSTR(FLIST[J])); OUTSTR(TB); END;
00267
00270 OUTSTR(CRLF);
00280 END;
00290
00300 OUTSTR("Enter corrections or additions. Type PH symbol followed by features. "&CRLF);
00310 OUTSTR("After each CR you will be prompted as to what is expected next."&CRLF);
00320 K←0;
00330 WHILE J≥0 DO BEGIN
00340 IF (READ1←STRIN("PH symbol = ")) ="" THEN DONE;
00350 K←K+1;
00360 FOR I←0 STEP 1 UNTIL 63 DO BEGIN
00370 IF PHLIST[I]=0 THEN PHLIST[I]←CVASC(READ1);
00380 IF CVASC(READ1)=PHLIST[I] THEN DONE;
00390 END;
00400 HLIST[I]←0;
00410 WHILE J≥0 DO BEGIN
00420 WHILE J≥0 DO BEGIN
00430 IF (READ2←STRIN("F="))="" THEN DONE;
00440 HPOINT←POINT(1,HLIST[I],-1);
00450 FOR J←0 STEP 1 UNTIL 35 DO BEGIN
00460 IBP(HPOINT);
00470 IF FLIST[J]=0 THEN BEGIN FLIST[J]←CVASC(READ2);
00480 OUTSTR(READ2&" added to feature list"&CRLF); END;
00490 IF CVASC(READ2)=FLIST[J] THEN DONE;
00500 END;
00510 IF J≥36 THEN OUTSTR("NOT FOUND"&CRLF) ELSE DONE;
00520 END;
00530 IF READ2 ="" THEN DONE;
00540 DPB(1,HPOINT);
00550 END;
00560 CLRBUF;
00570 END;
00580 OUTSTR(CRLF);
00590 IF K≠0 THEN BEGIN
00600 OUTSTR("PH list and H list table now contains"&CRLF);
00610 OUTSTR(CRLF&"PH"&TB&"Significant features"&CRLF);
00620 FOR I←0 STEP 1 UNTIL 63 DO BEGIN
00630 IF PHLIST[I]=0 THEN DONE;
00640 OUTSTR(CVSTR(PHLIST[I]));
00645 OUTSTR(TB);
00650 HPOINT←POINT(1,HLIST[I],-1);
00660 FOR J←0 STEP 1 UNTIL 35 DO
00670 IF (K←ILDB(HPOINT))=1 THEN BEGIN
00675 OUTSTR(CVSTR(FLIST[J])); OUTSTR(TB); END;
00677
00680 OUTSTR(CRLF);
00690 END;
00700 OUTSTR(CRLF);
00710 END;
00010 IF (STRIN("Do you want to start fresh from here on YorCR = "))="Y" THEN
00020 FOR I←0 STEP 1 UNTIL TABNUM-1 DO BEGIN
00030 NAMES[I]←PARENT[I]←LRN1[I]←LRN2[I]←LRN3[I]←LRN4[I]←0;
00040 IN1[I]←IN2[I]←IN3[I]←IN4[I]←0;
00045 OUT1[I]←OUT2[I]←OUT3[I]←OUT4[I]←0; END;
00050
00060 WHILE TRUE DO BEGIN "OVERAL"
00070 IF NAMES[0]=0 THEN OUTSTR("All tables have been zeroed"&crlf) else begin
00080
00090 OUTSTR(CRLF&"The following tables exist"&CRLF);
00100 OUTSTR("Name"&TB&"Parent"&TB&"Out1 Lev1 Out2 Lev2 "&
00110 "Out3 Lev3 Out4 Lev4 "&
00120 "IN1 IN2 IN3 IN4"&CRLF);
00130 SETFORMAT(3,0);
00140 FOR I←0 STEP 1 UNTIL TABNUM DO BEGIN
00150 IF NAMES[I]=0 THEN DONE;
00160 J←(IN1[I] LAND '77);K←(IN2[I] LAND '77);
00170 IF (IN3[I]=0) THEN READ1←" " ELSE
00180 READ1←CVSTR(INNAM[IN3[I] LAND '77])&" ";
00190 IF (IN4[I]=0) THEN READ2←" " ELSE
00200 READ2←CVSTR(INNAM[IN4[I] LAND '77])&" ";
00210 OUTALL(CVSTR(NAMES[I])&TB&CVSTR(PARENN[I])&TB&
00220 CVSTR(OUT1[I])&" "&CVS(LDB(POINT(9,LEVEL[I],8)))&" "&
00230 CVSTR(OUT2[I])&" "&CVS(LDB(POINT(9,LEVEL[I],17)))&" ");
00240 IF OUT3[I]=0 THEN OUTSTR(" ") ELSE
00250 OUTALL(CVSTR(OUT3[I])&" "&CVS(LDB(POINT(9,LEVEL[I],26)))&" ");
00260 IF OUT4[I]=0 THEN OUTSTR(" ") ELSE
00270 OUTALL(CVSTR(OUT4[I])&" "&CVS(LDB(POINT(9,LEVEL[I],35)))&" ");
00280 OUTALL(CVSTR(INNAM[J])&" "&CVSTR(INNAM[K])&" "
00290 &READ1&READ2&CRLF); END; END;
00300
00310 CLRBUF;
00320
00330 WHILE TRUE DO BEGIN "OUTSID"
00340
00350 WHILE TRUE DO BEGIN "GETNAM"
00360 OUTSTR(CRLF&"Now type the name of a table to be modified or added."&CRLF);
00370 IF (READ1←STRIN("A CR. only, terminates the session. Name= "))="" THEN DONE;
00380 J←CVASC(READ1);
00390 FOR I←0 STEP 1 UNTIL TABNUM DO IF NAMES[I]=J THEN DONE ELSE
00400 IF NAMES[I]=0 THEN DONE;
00410 IF NAMES[I]=J THEN DONE; CLRBUF;
00420 IF (READ2←STRIN("Is this a new table = "))="N" then
00430 OUTSTR("Try again"&CRLF) ELSE BEGIN NAMES[I]←J; DONE END; END "GETNAM";
00440 IF READ1="" THEN DONE;
00450
00460 WHILE TRUE DO BEGIN "PARENT" ⊂ SIG uses index 13 for start of OUTPUTS array;
00470 READ2←STRIN("Type name of parent (same name used for gating)= ");
00480 PARENN[I]←K←CVASC(READ2);
00490 IF READ2="" THEN BEGIN PARENT[I]←0; DONE; END;
00500 FOR J←0 STEP 1 UNTIL TABNUM-1 DO IF K=OUT1[J] THEN DONE;
00510 IF J<TABNUM THEN BEGIN
00520 PARENT[I]←'331113000000+J; DONE END ELSE
00530 FOR J←0 STEP 1 UNTIL TABNUM-1 DO IF K=OUT2[J] THEN DONE;
00540 IF J<TABNUM THEN BEGIN
00550 PARENT[I]←'221113000000+J; DONE END ELSE
00560 FOR J←0 STEP 1 UNTIL TABNUM-1 DO IF K=OUT3[J] THEN DONE;
00570 IF J<TABNUM THEN BEGIN
00580 PARENT[I]←'111113000000+J; DONE END ELSE
00590 FOR J←0 STEP 1 UNTIL TABNUM-1 DO IF K=OUT4[J] THEN DONE;
00600 IF J<TABNUM THEN BEGIN
00610 PARENT[I]←'001113000000+J; DONE END;
00620 OUTSTR("Name not found. "); END "PARENT";
00630
00640 OUTSTR("Up to 4 output names may be specified (Ph or Feature)"&CRLF);
00650 FOR L←0 STEP 1 UNTIL 3 DO BEGIN "OUTPUT"
00660 WHILE TRUE DO BEGIN
00670 IF (READ4←STRIN("Type output name ="))="" THEN DONE;
00680 IF L≤3 THEN OUT4[I]←0; IF L≤2 THEN OUT3[I]←0; IF L=0 THEN OUT2[I]←0;
00690 K←CVASC(READ4);
00700 READ5←STRIN("Type counter level for this output (0 to 511)= ");
00710 Q←CVD(READ5);
00720 IF L=0 THEN LEVEL[I]←(Q LSH 27) ELSE
00730 IF L=1 THEN LEVEL[I]←LEVEL[I]+(Q LSH 18) ELSE
00740 IF L=2 THEN LEVEL[I]←LEVEL[I] +(Q LSH 9) ELSE
00750 LEVEL[I]←LEVEL[I]+Q;
00760 FOR J←0 STEP 1 UNTIL 63 DO IF K=PHLIST[J] THEN DONE;
00770 IF J≤63 THEN BEGIN
00780 IF L=0 THEN BEGIN OUT1[I]←K; LRN1[I]←0; END ELSE
00790 IF L=1 THEN BEGIN OUT2[I]←K; LRN2[I]←0; END ELSE
00800 IF L=2 THEN BEGIN OUT3[I]←K; LRN3[I]←0; END ELSE
00810 IF L=3 THEN BEGIN OUT4[I]←K; LRN4[I]←0; END;
00820 DONE END;
00830 IF J≥64 THEN BEGIN
00840 HPNT1←POINT(1,LRN1[I],-1);
00850 HPNT2←POINT(1,LRN2[I],-1);
00860 HPNT3←POINT(1,LRN3[I],-1);
00870 HPNT4←POINT(1,LRN4[I],-1);
00880 FOR J←0 STEP 1 UNTIL 35 DO BEGIN
00890 IF L=0 THEN IBP(HPNT1); IF L=1 THEN IBP(HPNT2);
00900 IF L=2 THEN IBP(HPNT3); IF L=3 THEN IBP(HPNT4);
00910 IF K=FLIST[J] THEN DONE; END; END;
00920 IF J≤35 THEN BEGIN
00930 IF L=0 THEN BEGIN OUT1[I]←K; DPB(1,HPNT1); END ELSE
00940 IF L=1 THEN BEGIN OUT2[I]←K; DPB(1,HPNT2); END ELSE
00950 IF L=2 THEN BEGIN OUT3[I]←K; DPB(1,HPNT3); END ELSE
00960 IF L=3 THEN BEGIN OUT4[I]←K; DPB(1,HPNT4); END;
00970 DONE END;
00980 OUTSTR("Output name not found. "); END;
00990 IF READ4="" THEN BEGIN IF L≤2 THEN OUT3[I]←0; IF L≤3 THEN OUT4[I]←0;
01000 DONE END; END "OUTPUT";
01010
01020 OUTSTR("2, 3 or 4 inputs may be specified"&CRLF);
01030 FOR L←0 STEP 1 UNTIL 3 DO BEGIN "INPUTS"
01040 WHILE TRUE DO BEGIN
01050 IF (READ3←STRIN("Type INPUT NAME ="))="" THEN
01060 IF L>1 THEN DONE;
01070 K←CVASC(READ3);
01080 FOR J←0 STEP 1 UNTIL INSIZ-1 DO IF K=INNAM[J] THEN DONE;
01090 IF J=INSIZ THEN OUTSTR("Input name not found. ") ELSE DONE;
01100 END; IF READ3="" THEN DONE; INSAVE[L]←J;
01110 END "INPUTS";
01120
01130
01140 IF L=2 THEN BEGIN ⊂ SIG uses index 7 for start of INDAT array;
01150 IN1[I]←'020407000000+INSAVE[0];
01160 IN2[I]←'020407000000+INSAVE[1]; IN3[I]←IN4[I]←0; END;
01170
01180 IF L=3 THEN BEGIN
01190 IN1[I]←'030307000000+INSAVE[0];
01200 IN2[I]←'030307000000+INSAVE[1];
01210 IN3[I]←'040207000000+INSAVE[2]; IN4[I]←0; END;
01220
01230 IF L=4 THEN BEGIN
01240 IN1[I]←'040207000000+INSAVE[0];
01250 IN2[I]←'040207000000+INSAVE[1];
01260 IN3[I]←'040207000000+INSAVE[2];
01270 IN4[I]←'040207000000+INSAVE[3]; END;
01280 END "OUTSID";
00010 CHAN1←GETCHAN;
00020 CLOSE(CHAN1);
00030 OPEN(CHAN1,"DSK",'10,0,10,0,0,EOF);
00040 ENTER(CHAN1,"TABHED.DAT",0);
00050 ARRYOUT(CHAN1,INNAM[0],INSIZ);
00060 ARRYOUT(CHAN1,FLIST[0],36);
00070 ARRYOUT(CHAN1,PHLIST[0],64);
00080 ARRYOUT(CHAN1,HLIST[0],64);
00090 ARRYOUT(CHAN1,NAMES[0],TABNUM);
00100 ARRYOUT(CHAN1,PARENT[0],TABNUM);
00110 ARRYOUT(CHAN1,PARENN[0],TABNUM);
00120 ARRYOUT(CHAN1,GATE[0],TABNUM);
00130 ARRYOUT(CHAN1,IN1[0],TABNUM);
00140 ARRYOUT(CHAN1,IN2[0],TABNUM);
00150 ARRYOUT(CHAN1,IN3[0],TABNUM);
00160 ARRYOUT(CHAN1,IN4[0],TABNUM);
00170 ARRYOUT(CHAN1,OUT1[0],TABNUM);
00180 ARRYOUT(CHAN1,OUT2[0],TABNUM);
00190 ARRYOUT(CHAN1,OUT3[0],TABNUM);
00200 ARRYOUT(CHAN1,OUT4[0],TABNUM);
00210 ARRYOUT(CHAN1,LRN1[0],TABNUM);
00220 ARRYOUT(CHAN1,LRN2[0],TABNUM);
00230 ARRYOUT(CHAN1,LRN3[0],TABNUM);
00240 ARRYOUT(CHAN1,LRN4[0],TABNUM);
00250 ARRYOUT(CHAN1,LEVEL[0],TABNUM);
00260
00270 CLOSE(CHAN1);
00280 RELEASE(CHAN1);
00290 IF (READ1←STRIN("Do you want to review tables "))≠"Y" THEN
00300 DONE ; END "OVERAL";
00310
00320 CLOSE(CHAN2);
00330 OPEN(CHAN2,"DSK",0,0,10,0,0,EOF);
00340 ENTER(CHAN2,"TABLES.DOC",0);
00350 OUT(CHAN2,"PH list and H list table contains"&CRLF);
00360 OUT(CHAN2,CRLF&"PH"&TB&"Significant features"&CRLF);
00370 FOR I←0 STEP 1 UNTIL 63 DO BEGIN
00380 IF PHLIST[I]=0 THEN DONE;
00390 OUT(CHAN2,CVSTR(PHLIST[I])&TB);
00400 HPOINT←POINT(1,HLIST[I],-1);
00410 FOR J←0 STEP 1 UNTIL 35 DO
00420 IF (K←ILDB(HPOINT))=1 THEN OUT(CHAN2,CVSTR(FLIST[J])&TB);
00430 OUT(CHAN2,CRLF);
00440 END;
00450
00460 OUT(CHAN2,'14&"The following tables exist"&CRLF&LF);
00470 OUT(CHAN2,"Name"&TB&"Parent"&TB&"Out1 Lev1 Out2 Lev2 "&
00480 "Out3 Lev3 Out4 Lev4 "&
00490 "IN1 IN2 IN3 IN4"&CRLF);
00500 SETFORMAT(3,0);
00510 FOR I←0 STEP 1 UNTIL TABNUM DO BEGIN
00520 IF NAMES[I]=0 THEN DONE;
00530 J←(IN1[I] LAND '77);K←(IN2[I] LAND '77);
00540 IF (IN3[I]=0) THEN READ1←" "
00550 ELSE READ1←CVSTR(INNAM[IN3[I] LAND '77])&" ";
00560 IF (IN4[I]=0) THEN READ2←" " ELSE
00570 READ2←CVSTR(INNAM[IN4[I] LAND '77])&" ";
00580 OUT(CHAN2,CVSTR(NAMES[I])&TB&CVSTR(PARENN[I])&TB&
00590 CVSTR(OUT1[I])&CVS(LDB(POINT(9,LEVEL[I],8)))&" "&
00600 CVSTR(OUT2[I])&CVS(LDB(POINT(9,LEVEL[I],17)))&" ");
00610 IF OUT3[I]=0 THEN OUT(CHAN2," ") ELSE
00620 OUT(CHAN2,CVSTR(OUT3[I])&CVS(LDB(POINT(9,LEVEL[I],26)))&" ");
00630 IF OUT4[I]=0 THEN OUT(CHAN2," ") ELSE
00640 OUT(CHAN2,CVSTR(OUT4[I])&CVS(LDB(POINT(9,LEVEL[I],35)))&" ");
00650 OUT(CHAN2,CVSTR(INNAM[J])&" "&CVSTR(INNAM[K])&" "
00660 &READ1&READ2&CRLF); END;
00670 RELEASE(CHAN2);
00680 OUTSTR("Documents TABHED.DAT and TABLES.DOC have been created"&CRLF);
00690
00700 END "MAKE";